home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0087_4DOS File Descriptions.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  14KB  |  482 lines
  1.  
  2. { Please check below for the WINDOWS version of this code }
  3. {$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
  4.  
  5. Unit D4Dos;
  6. {
  7. ******************4DOS description functions****************
  8. Written by: W. de Vries, dVELP Services
  9. Target:     DOS real-mode
  10. Date:       March 1994
  11. Purpose:    Reading and modifying the 4DOS file descriptions
  12. ************************************************************
  13.  
  14. Usage: GetDescript(FileName / directoryname): String;
  15.        Returns the description of the filename or directory name.
  16.        Use a full path to specify the exact location of the file.
  17. }
  18.  
  19. Interface
  20.          Function GetDescript(Name:String):String;
  21.          Function SetDescript(Name, Descript: String): Boolean;
  22.  
  23. Implementation
  24. Uses DOS;
  25.  
  26. Function Upper(Str: String): String;
  27. {Replace this function if you've got a faster one}
  28.  
  29. Var i: Integer;
  30. Begin
  31.     For i := 1 to Length(Str) do
  32.         Str[i] := Upcase(Str[i]);
  33.     Upper := Str;
  34. end;
  35.  
  36. Function getDescriptFileName(Name: String): String;
  37. {Internal function that gives the complete path of DESCRIPT.ION}
  38. Var D: DirStr;
  39.     N: NameStr;
  40.     E: ExtStr;
  41.     tmp: PathStr;
  42. begin
  43.      If Name='' then
  44.      begin
  45.         getDescriptFileName := '';
  46.         exit;
  47.      end;
  48.      tmp := FExpand(Name);
  49.      FSplit(tmp, D, N, E);
  50.      Tmp:= D;
  51.      getDescriptFileName:= tmp+'DESCRIPT.ION';
  52. end;
  53.  
  54. Function GetName(Name: String): String;
  55. {Returns only the filename without the path}
  56.  
  57. Var D: DirStr;
  58.     N: NameStr;
  59.     E: ExtStr;
  60.     tmp: PathStr;
  61. Begin
  62.      If Name='' then
  63.      begin
  64.         getName := '';
  65.         exit;
  66.      end;
  67.      tmp := FExpand(Name);
  68.      FSplit(tmp, D, N, E);
  69.      getName:= N+E;
  70. end;
  71.  
  72. Function GetDescript(Name:String):String;
  73. {Input: The path/name of a file
  74. output: The 4DOS file description
  75.         or '' if there is no description}
  76.  
  77. Var
  78.     IOBuf: Array[0..2047] of Char; {2 Kb read-buffer}
  79.     f: text;
  80.     Regel, tmp: String;
  81.     Found : Boolean;
  82.  
  83. Begin
  84.      Found := False;
  85.      Assign(f,GetDescriptFileName(Name));
  86.      SetTextBuf(F, IOBuf);
  87.      {$I-} Reset(f);{$I+}
  88.      If IOResult <> 0 then
  89.      begin
  90.         GetDescript := '';
  91.         exit;
  92.      end;
  93.      While (not Found) and (not eof(f)) do
  94.      begin
  95.            ReadLn(f, regel);
  96.            Tmp := Copy(Regel, 1, Pos(' ', regel)-1);
  97.            Found := Upper(Tmp) = Upper(GetName(Name));
  98.      end;
  99.      If Found then
  100.      begin
  101.        GetDescript := Copy(Regel, Pos(' ', Regel)+1, Length(Regel));
  102.      end
  103.      else
  104.        GetDescript := '';
  105.      Close(f);
  106. end;
  107.  
  108. Function SetDescript(Name, Descript: String): Boolean;
  109. {Input: the path/name of a file, the description of the file. Enter '' for
  110.         the description to remove it.
  111. Output: True if the description has been succesfully set, otherwise
  112.         it is false.}
  113.  
  114.  
  115. Type FileInfo=^FileRec;
  116.     FileRec= Record
  117.               FileName: String;
  118.               Str: String;
  119.               Next: FileInfo;
  120.     end;
  121.  
  122. Var f: Text;
  123.     IOBuf: Array[0..2047] of Char; {2 Kb read-buffer}
  124.     BeginPtr, UsePtr, EndPtr: FileInfo;
  125.     regel, tmp: String;
  126.     FileFound: Boolean;
  127.  
  128.   Procedure ReadInfo;
  129.   {Read all descriptions in a pointer-array}
  130.   Begin
  131.       {$I-} Reset(f); {$I+}
  132.       FileFound := False;
  133.       BeginPtr := nil;
  134.       UsePtr := nil;
  135.       EndPtr := nil;
  136.       If (IOResult <> 0) or (eof(f)) then
  137.       begin {The DESCRIPT.ION file does not exist: create a new one}
  138.             {$I-} Rewrite(f);{$I+}
  139.             if IOResult <> 0 then
  140.                   exit;
  141.             BeginPtr := New(FileInfo);{Create a new record}
  142.             BeginPtr^.FileName := Upper(GetName(Name));
  143.             BeginPtr^.Str := Descript;
  144.             BeginPtr^.Next := nil;
  145.             EndPtr := BeginPtr;
  146.       end else
  147.         While not eof(f) do
  148.         begin
  149.            Readln(f, regel);
  150.            UsePtr := New(FileInfo); {just create a new record}
  151.            tmp := Copy(Regel, 1, Pos(' ', regel)-1);
  152.            UsePtr^.FileName := tmp;
  153.            If Upper(tmp)=Upper(GetName(Name)) then
  154.            begin
  155.               FileFound := True;
  156.               If Descript <> '' then
  157.               begin
  158.                  UsePtr^.FileName := getName(tmp); {File found in list, change it!}
  159.                  UsePtr^.Str := Descript;
  160.                  UsePtr^.Next := nil;
  161.               end else
  162.               begin
  163.                  Dispose(UsePtr); {Description is NIL, remove the new record}
  164.                  UsePtr := nil;
  165.               end;
  166.            end else
  167.            begin
  168.               UsePtr^.FileName := GetName(tmp);
  169.               If Regel <> '' then
  170.                   tmp :=Copy(Regel, Pos(' ', Regel)+1, Length(Regel))
  171.               else
  172.                   tmp := '';
  173.               UsePtr^.Str := tmp;
  174.               UsePtr^.Next := nil;
  175.            end;
  176.  
  177.            If BeginPtr=nil then
  178.            begin
  179.               BeginPtr := UsePtr; {Created a new array}
  180.               EndPtr := BeginPtr;      {Point the endpointer to the begin}
  181.            end else
  182.            begin
  183.               EndPtr^.Next := UsePtr; {Stick the new record to the previous one}
  184.               If UsePtr <> nil then
  185.                  EndPtr := UsePtr;  {Point the EndPtr to the last record}
  186.            end;
  187.         end;
  188.         If (not FileFound) and (Descript <> '') then
  189.         begin
  190.             UsePtr := New(FileInfo); {Create a new record}
  191.             UsePtr^.FileName := Upper(getName(Name));
  192.             UsePtr^.Str := Descript;
  193.             UsePtr^.Next := nil;
  194.             EndPtr^.Next := UsePtr;
  195.             EndPtr := UsePtr;
  196.         end;
  197.         Close(f); {Close file}
  198.   end;
  199.  
  200.   Function WriteInfo: Boolean;
  201.   Begin
  202.       SetFAttr(f, Archive); {Unhide the file}
  203.       WriteInfo := True;
  204.       {$I-} Rewrite(f); {$I+}
  205.       If IOResult <> 0 then
  206.       begin
  207.          WriteInfo := False;
  208.          Exit;
  209.       end;
  210.       If BeginPtr = nil then
  211.       begin
  212.            Close(f);   {No descriptions: delete file}
  213.            Erase(f);
  214.            exit;
  215.       end;
  216.       While BeginPtr <> nil do
  217.       Begin
  218.            Writeln(f, BeginPtr^.FileName, ' ', BeginPtr^.Str);
  219.            UsePtr := BeginPtr;
  220.            BeginPtr := UsePtr^.Next; {Move the begin-pointer 1 up}
  221.            Dispose(UsePtr);      {Delete first record}
  222.       end;
  223.       Close(f);
  224.       SetFAttr(f, Hidden); {Hide the DESCRIPT.ION file}
  225.   end;
  226.  
  227. Begin
  228.      SetDescript := False;
  229.      If Name='' then
  230.         Exit;                              {If there's no name specified:
  231. quit}
  232.      Assign(f, GetDescriptFileName(Name)); {Open DESCRIPT.ION}
  233.      SetTextBuf(f, IOBuf);                 {create a 2Kb buffer}
  234.      ReadInfo;                             {Read the descriptions}
  235.      SetDescript := WriteInfo;             {Write the descriptions}
  236. end;
  237.  
  238.  
  239. Begin
  240. end.
  241.  
  242.  
  243. {   FOLLOWING IS THE WINDOWS SPECIFIC CODE FOR THIS UNIT !! }
  244.  
  245. {$A+,B-,D-,F-,G+,I+,K+,L-,N+,P-,Q+,R+,S+,T+,V+,W+,X+,Y-}
  246.  
  247. Unit W4Dos;
  248. {******************4DOS description functions****************
  249. Written by: W. de Vries, dVELP Services
  250. Target:     Windows, DPMI
  251. Date:       March 1994
  252. Purpose:    Reading and modifying the 4DOS file descriptions
  253. ************************************************************}
  254.  
  255. Interface
  256.          Function GetDescript(Name:PChar):PChar;
  257.          Function SetDescript(Name, Descript: PChar): Boolean;
  258.  
  259. Implementation
  260. Uses Windos, Strings, WinCrt;
  261.  
  262. Function getDescriptFileName(Name: PChar): PChar;
  263. {Internal function that gives the complete path of DESCRIPT.ION}
  264. Var D: array[0..fsDirectory] of Char;
  265.     N: Array[0..fsFileName] of Char;
  266.     E: Array[0..fsExtension] of Char;
  267.     tmp: PChar;
  268. begin
  269.      If Name=nil then
  270.      begin
  271.         getDescriptFileName := nil;
  272.         exit;
  273.      end;
  274.      GetMem(tmp, 256);
  275.      FileExpand(tmp, Name);
  276.      FileSplit(tmp, D, N, E);
  277.      StrCopy(Tmp, D);
  278.      StrCat(Tmp, 'DESCRIPT.ION');
  279.      getDescriptFileName:= StrNew(Tmp);
  280. end;
  281.  
  282. Function GetName(Name: PChar): PChar;
  283. {Returns only the filename without the path}
  284.  
  285. Var D: Array[0..fsDirectory] of Char;
  286.     N: Array[0..fsFileName] of Char;
  287.     E: Array[0..fsExtension] of Char;
  288.     tmp: PChar;
  289. Begin
  290.      If Name=nil then
  291.      begin
  292.         getName := nil;
  293.         exit;
  294.      end;
  295.      GetMem(tmp, 256);
  296.      FileExpand(tmp, Name);
  297.      FileSplit(tmp, nil, N, E);
  298.      StrCopy(Tmp, N);
  299.      StrCat(tmp, E);
  300.      getName:= StrNew(tmp);
  301.      StrDispose(tmp);
  302. end;
  303.  
  304.  
  305. Function GetDescript(Name:PChar):PChar;
  306. {Input: The path/name of a file
  307. output: The 4DOS file description
  308.         or NIL if there is no description}
  309.  
  310. Var
  311.     IOBuf: Array[0..2047] of Char; {2 Kb read-buffer}
  312.     f: text;
  313.     Regel: String;
  314.     tmp: PChar;
  315.     Found : Boolean;
  316.  
  317. Begin
  318.      Found := False;
  319.      GetMem(tmp, 256);
  320.      Assign(f,GetDescriptFileName(Name));
  321.      SetTextBuf(F, IOBuf);
  322.      {$I-} Reset(f);{$I+}
  323.      If IOResult <> 0 then
  324.      begin
  325.         GetDescript := nil;
  326.         StrDispose(Tmp);
  327.         exit;
  328.      end;
  329.      While (not Found) and (not eof(f)) do
  330.      begin
  331.            ReadLn(f, regel);
  332.            StrPCopy(Tmp, Copy(Regel, 1, Pos(' ', regel)-1));
  333.            Found := StrIComp(tmp,GetName(Name))=0;
  334.      end;
  335.      If Found then
  336.      begin
  337.        GetDescript := StrNew(StrPCopy(tmp, Copy(Regel, Pos(' ', Regel)+1, Length(Regel))));
  338.      end
  339.      else
  340.        GetDescript := nil;
  341.      Close(f);
  342.      StrDispose(tmp);
  343. end;
  344.  
  345. Function SetDescript(Name, Descript: PChar): Boolean;
  346. {Input: the path/name of a file, the description of the file. Enter NIL for
  347.         the description to remove it.
  348. Output: True if the description has been succesfully set, otherwise
  349.         it is false.}
  350.  
  351.  
  352. Type FileInfo=^FileRec;
  353.     FileRec= Record
  354.               FileName:PChar;
  355.               Str: PChar;
  356.               Next: FileInfo;
  357.     end;
  358.  
  359. Var f: Text;
  360.     IOBuf: Array[0..2047] of Char; {2 Kb read-buffer}
  361.     BeginPtr, UsePtr, EndPtr: FileInfo;
  362.     regel: String;
  363.     tmp: Array[0..255] of Char;
  364.     FileFound: Boolean;
  365.  
  366.   Procedure ReadInfo;
  367.   {Read all descriptions in a pointer-array}
  368.   Begin
  369.       If Descript <> nil then
  370.          If StrIComp(Descript, '') = 0 then
  371.             Descript := nil;
  372.       FileFound := False;
  373.       BeginPtr := nil;
  374.       UsePtr := nil;
  375.       EndPtr := nil;
  376.       {$I-} Reset(f); {$I+}
  377.       If (IOResult <> 0) or (eof(f)) then
  378.       begin {The DESCRIPT.ION file does not exist: create a new one}
  379.             {$I-} Rewrite(f); {$I+}
  380.             If IOResult <> 0 then
  381.                Exit;
  382.             BeginPtr := New(FileInfo);{Create a new record}
  383.             BeginPtr^.FileName := StrNew(StrUpper(GetName(Name)));
  384.             BeginPtr^.Str := StrNew(Descript);
  385.             BeginPtr^.Next := nil;
  386.             EndPtr := BeginPtr;
  387.             FileFound := True;
  388.       end else
  389.  
  390.         While not eof(f) do
  391.         begin
  392.            Readln(f, regel);
  393.            UsePtr := New(FileInfo); {just create a new record}
  394.            StrPCopy(tmp, Copy(Regel, 1, Pos(' ', regel)-1));
  395.            UsePtr^.FileName := StrNew(GetName(tmp));
  396.            If StrIComp(tmp, GetName(Name))=0 then
  397.            begin  {File found in list, change it!}
  398.               FileFound := True;
  399.               If Descript <> nil then
  400.               begin
  401.                  UsePtr^.Str := StrNew(Descript);
  402.                  UsePtr^.Next := nil;
  403.               end else
  404.               begin
  405.                  Dispose(UsePtr); {Description is NIL, remove the new record}
  406.                  UsePtr := nil;
  407.               end;
  408.            end else
  409.            begin
  410.               If Regel <> '' then
  411.                   StrPCopy(tmp, Copy(Regel, Pos(' ', Regel)+1, Length(Regel)))
  412.               else
  413.                   tmp[0] := #0;
  414.               UsePtr^.Str := StrNew(tmp);
  415.               UsePtr^.Next := nil;
  416.            end;
  417.  
  418.            If BeginPtr=nil then
  419.            begin
  420.               BeginPtr := UsePtr; {Created a new array}
  421.               EndPtr := BeginPtr;      {Point the endpointer to the begin}
  422.            end else
  423.            begin
  424.               EndPtr^.Next := UsePtr; {Stick the new record to the previous}
  425.               If UsePtr <> nil then
  426.                  EndPtr := UsePtr;  {Point the EndPtr to the last record}
  427.            end;
  428.         end;
  429.  
  430.         If (not FileFound) and (Descript <> nil) then
  431.         begin
  432.             UsePtr := New(FileInfo); {Create a new record}
  433.             UsePtr^.FileName := StrNew(StrUpper(getName(Name)));
  434.             UsePtr^.Str := StrNew(Descript);
  435.             UsePtr^.Next := nil;
  436.             EndPtr^.Next := UsePtr;
  437.             EndPtr := UsePtr;
  438.         end;
  439.       Close(f); {Close file}
  440.   end;
  441.  
  442.   Function WriteInfo: Boolean;
  443.   Begin
  444.       SetFAttr(f, faArchive); {Unhide the file}
  445.       WriteInfo := True;
  446.       {$I-} Rewrite(f); {$I+}
  447.       If IOResult <> 0 then
  448.       begin
  449.          WriteInfo := False;
  450.          Exit;
  451.       end;
  452.       If BeginPtr=nil then
  453.       begin
  454.            Close(f);   {No descriptions: delete file}
  455.            Erase(f);
  456.            exit;
  457.       end;
  458.       While BeginPtr <> nil do
  459.       Begin
  460.            Writeln(f, BeginPtr^.FileName, ' ', BeginPtr^.Str);
  461.            UsePtr := BeginPtr;
  462.            BeginPtr := UsePtr^.Next; {Move the begin-pointer 1 up}
  463.            Dispose(UsePtr);      {Delete first record}
  464.       end;
  465.       Close(f);
  466.       SetFAttr(f, faHidden); {Hide the DESCRIPT.ION file}
  467.   end;
  468.  
  469. Begin
  470.      SetDescript := False;
  471.      If (Name=nil) or (StrIComp(Name, '')=0) then
  472.         Exit;                              {If there's no name specified: quit}
  473.      Assign(f, GetDescriptFileName(Name)); {Open DESCRIPT.ION}
  474.      SetTextBuf(f, IOBuf);                 {create a 2Kb buffer}
  475.      ReadInfo;                             {Read the descriptions}
  476.      SetDescript := WriteInfo;             {Write the descriptions}
  477. end;
  478.  
  479.  
  480. Begin
  481. end.
  482.